 Member
!_ABCDllMode_  EQUATE(0)
!_ABCLinkMode_ EQUATE(1)

 Map
   !Local Procedures, if any, go here
   !API Prototypes
   Module('api')
        lstrlen(long),SIGNED,PASCAL,NAME('lstrLenA')
        FormatMessage(ulong,long,ulong,ulong,long,ulong,long),ulong,PASCAL,RAW,Name('FormatMessageA')
        LocalFree(long),long,PASCAL,proc
        memcpy(long,long,long),long,name('_memcpy'),proc
        getlasterror(),ulong,pascal,name('getlasterror')
        LoadLibrary(*cstring),unsigned,PASCAL,RAW,NAME('LoadLibraryA')
        FreeLibrary(unsigned),BOOL,PASCAL,proc
        GetProcAddress(unsigned, *Cstring),long,pascal,raw
        strcpy(long,long),long,pascal,raw,name('lstrcpy'),proc
   end
   module('calla')
    CallA_P0(long,long,long,long),long,name('CALLA')
    CallA_P1(long,long,long,long,long),long,Name('CALLA')
    CallA_P2(long,long,long,long,long,long),long,Name('CALLA')
    callA_p3(long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p4(long,long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p5(long,long,long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p6(long,long,long,long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p7(long,long,long,long,long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p8(long,long,long,long,long,long,long,long,long,long,long,long),long,Name('CALLA')
    callA_p9(long,long,long,long,long,long,long,long,long,long,long,long,long),long,Name('CALLA')
   callA_p10(long,long,long,long,long,long,long,long,long,long,long,long,long,long),long,Name('CALLA')
    fixstack(long,long,long,long),long,name('FIXSTACK')
   End
   module('')
     clastart(long lpproc,long pStackSize),long,proc,name('CLA$START')
     clastart1(long lpproc,long pStackSize,string param1),long,proc,name('CLA$START1')
     clastart2(long lpproc,long pStackSize,string param1, string param2),long,proc,name('CLA$START2') 
     clastart3(long lpproc,long pStackSize,string param1, string param2, string param3),long,proc,name('CLA$START3') 
   end
 end

!Includes this class and others
 include('calldllcl.inc')

!global data for this module
Return:Benign equate(0)
Return:Fatal  equate(3)
Return:Notify equate(5)

AddressQtype queue,type
procname string(120)
lpaddress long
  end
!-------------------------------------------------------------
!---Start of calldllcl - construct, destruct, Init, Kill and takeError functions first
!-------------------------------------------------------------
calldllclType.construct           procedure()
  code
  clear(SELF)
  SELF.AddressQ &= New AddressQtype
calldllclType.destruct            procedure()
  code
  dispose(SELF.AddressQ)


calldllclType.Init                  Procedure(string pDllPath, byte pDebug=0)
cPath cstring(File:maxfilepath),auto
  Code
  clear(SELF.eProcFail)
  SELF.Debug=pDebug
  if ~pDllPath then
    SELF.IgnoreHDLL=true
  else
    SELF.IgnoreHdll=false
  cpath=clip(pDllPath)
  SELF.hdll=loadlibrary(cpath)
  if ~SELF.hdll then
    SELF.TakeError('LoadLibrary failed for: ' & cpath)
    return return:fatal
  end
  end
  Return Return:benign

calldllclType.Kill              Procedure()
!destroy any dynamic objects and clean up
    Code
    if ~SELF.addressQ&=NULL then free(SELF.AddressQ).
    if SELF.hdll and ~SELF.IgnoreHDLL then freelibrary(SELF.hdll);clear(SELF.hdll).
    RETURN

CallDllClType.TakeError     Procedure(string pError)
  code
  SELF.Errorstr=pError
  If SELF.Debug then message(pError).
  return



!----------  Address management ----------------------------------------------

CallDllcltype.SetProcFailCode     procedure(long pFailcode)
  Code
  SELF.eProcFail = pFailcode
  return 0


Calldllcltype.addaddress        Procedure(string procname, long lpProcName)
  code
  SELF.AddressQ.procname=procname
  get(SELF.AddressQ, SELF.AddressQ.Procname)
  if Errorcode() then
    SELF.AddressQ.lpaddress=lpProcname
    add(SELF.AddressQ,SELF.AddressQ.ProcName)
    if errorcode() then return 3.
  else
    SELF.AddressQ.lpAddress=lpProcName
    put(SELF.AddressQ)
    if errorcode() then return 3.
  end
  return 0

CallDllclType.GetAddress        Procedure(string procname)
cProcName cstring(80),auto
lpaddress long,auto
  code
  if ~SELF.hdll and ~SELF.Ignorehdll then
    SELF.TakeError('Get Address called before a dll is loaded!!!')
    Return SELF.eProcFail
  end

  SELF.AddressQ.procname=procname
  get(SELF.AddressQ, SELF.AddressQ.Procname)
  if ~Errorcode() then
    return SELF.AddressQ.lpAddress
  end

  !exit now if no dll loaded - the next block of code
  !  requires an hdll.
  if SELF.Ignorehdll then return SELF.eProcFail. 

  cProcName=clip(procname)
  lpAddress=GetProcAddress(SELF.hdll,cProcName)
  if lpAddress then
    SELF.AddressQ.procname=procname
    SELF.AddressQ.lpAddress=lpaddress
    add(SELF.AddressQ,SELF.Addressq.procname)
  else
    SELF.TakeError('get adress failed for ' & cProcName)
    Return SELF.eProcFail
  end
  return lpaddress
!------------------------- Pascal Calling convention call functions -------------------
calldllcltype.call procedure(string procname, <long p1>,<long p2>,<long p3>,<long p4>,<long p5>,<long p6>,<long p7>,<long p8>,<long p9>,<long p10>)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  if omitted(3) then return callA_p0(lpaddress,0,0,0).  !p0
  if omitted(4) then return callA_p1(lpaddress,0,0,0,p1). !p1
  if omitted(5) then return callA_p2(lpaddress,0,0,0,p2,p1). !p2
  if omitted(6) then return callA_p3(lpaddress,0,0,0,p3,p2,p1). !p3
  if omitted(7) then return callA_p4(lpaddress,0,0,0,p4,p3,p2,p1). !p4
  if omitted(8) then return callA_p5(lpaddress,0,0,0,p5,p4,p3,p2,p1). !p5
  if omitted(9) then return callA_p6(lpaddress,0,0,0,p6,p5,p4,p3,p2,p1). !p6
  if omitted(10) then return callA_p7(lpaddress,0,0,0,p7,p6,p5,p4,p3,p2,p1). !p7
  if omitted(11) then return callA_p8(lpaddress,0,0,0,p8,p7,p6,p5,p4,p3,p2,p1). !p8
  if omitted(12) then return callA_p9(lpaddress,0,0,0,p9,p8,p7,p6,p5,p4,p3,p2,p1). !p9
  return callA_p10(lpaddress,0,0,0,p10,p9,p8,p7,p6,p5,p4,p3,p2,p1)

calldllcltype.callbyAddress procedure(long lpAddress, <long p1>,<long p2>,<long p3>,<long p4>,<long p5>,<long p6>,<long p7>,<long p8>,<long p9>,<long p10>)
  code
  if omitted(3) then return callA_p0(lpaddress,0,0,0).  !p0
  if omitted(4) then return callA_p1(lpaddress,0,0,0,p1). !p1
  if omitted(5) then return callA_p2(lpaddress,0,0,0,p2,p1). !p2
  if omitted(6) then return callA_p3(lpaddress,0,0,0,p3,p2,p1). !p3
  if omitted(7) then return callA_p4(lpaddress,0,0,0,p4,p3,p2,p1). !p4
  if omitted(8) then return callA_p5(lpaddress,0,0,0,p5,p4,p3,p2,p1). !p5
  if omitted(9) then return callA_p6(lpaddress,0,0,0,p6,p5,p4,p3,p2,p1). !p6
  if omitted(10) then return callA_p7(lpaddress,0,0,0,p7,p6,p5,p4,p3,p2,p1). !p7
  if omitted(11) then return callA_p8(lpaddress,0,0,0,p8,p7,p6,p5,p4,p3,p2,p1). !p8
  if omitted(12) then return callA_p9(lpaddress,0,0,0,p9,p8,p7,p6,p5,p4,p3,p2,p1). !p9
  return callA_p10(lpaddress,0,0,0,p10,p9,p8,p7,p6,p5,p4,p3,p2,p1)

!--------------------- Clarion Start Wrapper --------------------------------
CallDllClType.Start   procedure(String pMdiForm, long StackSize=0,<string pS1>,<String pS2>,<String pS3>)
lpMdiForm long,auto
  code
  lpMdiForm = SELF.GetAddress(pMdiForm)
  if lpMdiForm=SELF.eProcFail then
    SELF.TakeError('Start address resolution failed')
    return 0
  end
  if OMITTED(4) and Omitted(5) and Omitted(6) then
    Return CLASTART(lpMdiForm, Stacksize)
  end
  if ~Omitted(4) and Omitted(5) and Omitted(6) then
    Return CLASTART1(lpMdiForm, StackSize, pS1)
  end
  if ~Omitted(4) and ~Omitted(5) and Omitted(6) then
    Return ClaStart2(lpMdiForm, stacksize, pS1, pS2)
  end
  if ~Omitted(4) and ~Omitted(5) and ~Omitted(6) then
    Return ClaStart3(lpMdiForm, stacksize, pS1, pS2, pS3)
  end
  SELF.TakeError('Start called with illegal parameters')
  return 0
  
CallDllClType.StartbyAddress       procedure(long lpMDiForm, long StackSize=0,<string pS1>,<String pS2>,<String pS3>)
  code
  if OMITTED(4) and Omitted(5) and Omitted(6) then
    Return CLASTART(lpMdiForm, Stacksize)
  end
  if ~Omitted(4) and Omitted(5) and Omitted(6) then
    Return CLASTART1(lpMdiForm, StackSize, pS1)
  end
  if ~Omitted(4) and ~Omitted(5) and Omitted(6) then
    Return ClaStart2(lpMdiForm, stacksize, pS1, pS2)
  end
  if ~Omitted(4) and ~Omitted(5) and ~Omitted(6) then
    Return ClaStart3(lpMdiForm, stacksize, pS1, pS2, pS3)
  end
  SELF.TakeError('Start called with illegal parameters')
  return 0



!---------------- API error handling wrappers --------------------------

calldllcltype.getLasterror  procedure()
  code
  return getlasterror()

CallDllCltype.FormatErrMsg procedure(*string msg)
  code
  Return SELF.FormatErrMsg(msg,SELF.GetLastError())
calldllClType.FormatErrMsg procedure(*string msg,long EC)!,byte,proc
lpMsgBuf  long,auto  !Address of message string formated by FormatMessage Call
lenMsgBuf long,auto  !char in cstring return by formatMessage
res       byte(3)
  code
  SELF.ApiErrorcode=EC
  If FormatMessage(1100H, | !Format_Message_Allocate_Buffer + Format_message_From_System
                   0, EC,0,Address(lpMsgBuf),0,0)
    lenMsgBuf = lstrlen(lpmsgBuf)
    If lenMsgBuf then
      lenMsgBuf = choose(lenMsgBuf>size(Msg), size(Msg), lenmsgbuf)
      Clear(Msg)
      memcpy(Address(Msg), lpMsgBuf, lenMsgBuf)
      res=0
    end
    If lpMsgBuf then  LocalFree(lpMsgBuf). !clean up allocated memory
  end
  Return res
!------------------- c-call stuff ------------------------------------
calldllcltype.ccall procedure(string procname, <long p1>,<long p2>,<long p3>,<long p4>,<long p5>)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  if omitted(3) then return callA_p0(lpaddress,0,0,0).  !p0
  if omitted(4) then return fixstack(CallA_p1(lpaddress,0,0,0,p1),4,0,0). !p1
  if omitted(5) then return fixstack(CallA_p2(lpaddress,0,0,0,p2,p1),8,0,0). !p2
  if omitted(6) then return fixstack(CallA_p3(lpaddress,0,0,0,p3,p2,p1),12,0,0). !p3
  if omitted(7) then return fixstack(CallA_p4(lpaddress,0,0,0,p4,p3,p2,p1),16,0,0). !p4
  return fixstack(CallA_p5(lpaddress,0,0,0,p5,p4,p3,p2,p1),20,0,0)

calldllcltype.ccallbyAddress procedure(long lpAddress, <long p1>,<long p2>,<long p3>,<long p4>,<long p5>)
  code
  if omitted(3) then return callA_p0(lpaddress,0,0,0).  !p0
  if omitted(4) then return fixstack(CallA_p1(lpaddress,0,0,0,p1),4,0,0). !p1
  if omitted(5) then return fixstack(CallA_p2(lpaddress,0,0,0,p2,p1),8,0,0). !p2
  if omitted(6) then return fixstack(CallA_p3(lpaddress,0,0,0,p3,p2,p1),12,0,0). !p3
  if omitted(7) then return fixstack(CallA_p4(lpaddress,0,0,0,p4,p3,p2,p1),16,0,0). !p4
  return fixstack(CallA_p5(lpaddress,0,0,0,p5,p4,p3,p2,p1),20,0,0)


!---------------utility function for dereferenceing a variable----------------
CallDllClType.DeRefPointer  procedure(long lpPointer, *long pDeref)
!typical use
!  mydllfunc is a function in a dll loaded by clarion ,dll(dll_mode) atribute
!  CallDllCl.DerefPointer(Address(MyDllFunct),lpMyDllFunct)
  code
  if ~lpPointer then clear(pDeref);return return:fatal.
  memcpy(Address(pDeref),lpPointer,4)
  Return Return:Benign

CallDllCltype.AddAddressDeref  procedure(long lpPointer, string pName)
pDeref long,auto
  code
  if ~pName then return return:fatal. 
  if SELF.DerefPointer(lppointer,pDeref) then return return:fatal.
  Return(SELF.addaddress(pname, pDeref))

!----- redundant not terribly usefull -------------------------

Calldllcltype.ccall_p0           procedure(string procname)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p0(lpaddress,0,0,0)
calldllcltype.ccall_p1           procedure(string procname, long p1)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return fixstack(CallA_p1(lpaddress,4,0,0,p1),2,0,0)

calldllcltype.ccall_p2           procedure(string procname, long p1, long p2)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return fixstack(CallA_p2(lpaddress,0,0,0,p2, p1),8,0,0)


calldllcltype.ccall_p3           procedure(string procname, long p1, long p2, long p3)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return fixstack(CallA_p3(lpaddress,0,0,0,p3,p2,p1),12,0,0)

calldllcltype.ccall_p4           procedure(string procname, long p1, long p2, long p3, long p4)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return fixstack(CallA_p4(lpaddress,0,0,0,p4,p3,p2,p1),16,0,0)

calldllcltype.ccall_p5           procedure(string procname, long p1, long p2, long p3, long p4,long p5)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return fixstack(CallA_p5(lpaddress,0,0,0,p5,p4,p3,p1,p1),20,0,0)

Calldllcltype.call_p0           procedure(string procname)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p0(lpaddress,0,0,0)

calldllcltype.call_p1           procedure(string procname, long p1)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p1(lpaddress,0,0,0,p1)

calldllcltype.call_p2           procedure(string procname, long p1, long p2)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p2(lpaddress,0,0,0,p2, p1)


calldllcltype.call_p3           procedure(string procname, long p1, long p2, long p3)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p3(lpaddress,0,0,0,p3,p2,p1)

calldllcltype.call_p4           procedure(string procname, long p1, long p2, long p3, long p4)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p4(lpaddress,0,0,0,p4,p3,p2,p1)

calldllcltype.call_p5           procedure(string procname, long p1, long p2, long p3, long p4,long p5)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p5(lpaddress,0,0,0,p5,p4,p3,p2,p1)

calldllcltype.call_p8           procedure(string procname, long p1, long p2, long p3, long p4,long p5, long p6, long p7,long p8)
lpaddress long,auto
  code
  lpaddress=SELF.GetAddress(procname)
  if ~lpaddress then Return SELF.eProcFail.
  return callA_p8(lpaddress,0,0,0,p8,p7,p6,p5,p4,p3,p2,p1)
